home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / system / 4utils84.zip / scanlzhf.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-08  |  6KB  |  192 lines
  1. UNIT ScanLZHFiles;
  2. {$V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.    (c) 1992, 1993 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  13.                and change it free of charge, but you may not sell or hire
  14.                this part of 4DESC. The copyright remains in our hands.
  15.  
  16.                If you make any (considerable) changes to the source code,
  17.                please let us know. (send a copy or a listing).
  18.                We would like to see what you have done.
  19.  
  20.                We, David Frey and Tom Bowden, the authors, provide absolutely
  21.                no warranty of any kind. The user of this software takes the
  22.                entire risk of damages, failures, data losses or other
  23.                incidents.
  24.  
  25.  
  26.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  27.  
  28.    This unit provides the extraction of file names in .LZH files.
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. INTERFACE USES Dos, Globals;
  33.  
  34. PROCEDURE SearchInLZHFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  35.                           VAR Dir: PathStr; VAR lhsearch: SearchRec);
  36. PROCEDURE ShowCompLZHFileData(VAR search,lhsearch: SearchRec;VAR Path: PathStr;
  37.                               csize: LONGINT);
  38.  
  39. VAR OldLHFileName: PathStr;
  40.  
  41. IMPLEMENTATION USES Objects, Drivers, StringDateHandling;
  42.  
  43. PROCEDURE SearchInLZHFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  44.                           VAR Dir: PathStr; VAR lhsearch: SearchRec);
  45.  
  46. VAR i        : WORD;
  47.     k, Dummy : BYTE;
  48.     LHAFile  : NameExtStr;
  49.  
  50. BEGIN (* SearchInLZHFile *)
  51.  Assign(f,lhsearch.Name); Reset(f,1);
  52.  
  53.  BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 2; FilePtr := 2;
  54.  (* first 2 unknown bytes skipped *)
  55.  REPEAT
  56.   s := '';
  57.   REPEAT
  58.    s := s+Chr(ReadByte);
  59.   UNTIL (Pos('-lh',s) > 0) OR (BufPtr > BytesRead);
  60.   Dummy := ReadByte; Dummy := ReadByte; (* overread Method *)
  61.  
  62.   IF BufPtr < BytesRead THEN
  63.    BEGIN
  64.     csize       := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  65.     Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  66.     Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  67.     Search.attr := ReadByte;
  68.     Dummy := ReadByte; (* unknown 2 *)
  69.  
  70.     WITH Search DO
  71.      BEGIN
  72.       name  := ''; FOR i := 1 TO ReadByte DO name := name+DownCase(Chr(ReadByte));
  73.      END;
  74.  
  75.     FOR k := 1 TO FileSpecs DO
  76.      BEGIN
  77.       FSplit(FileSpec[k],Path,name,ext);
  78.       WHILE Length(name) < 8 DO name := name+' ';
  79.       IF Ext = '' THEN Ext := '.   '
  80.       ELSE
  81.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  82.  
  83.       i := Pos('*',name);
  84.       IF  i > 0 THEN
  85.        WHILE i <= 8 DO
  86.         BEGIN
  87.          name[i] := '?'; INC(i);
  88.         END;
  89.  
  90.       i := Pos('*',ext);
  91.       IF  i > 0 THEN
  92.        WHILE i <= 4 DO
  93.         BEGIN
  94.          ext[i] := '?'; INC(i);
  95.         END;
  96.       FileSpec[k] := Path+name+ext;
  97.  
  98.       FSplit(Search.Name,Path,name,ext);
  99.       WHILE Length(name) < 8 DO name := name +' ';
  100.       IF Ext = '' THEN Ext := '.   '
  101.       ELSE
  102.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  103.       LHAFile:= Path+name+ext;
  104.  
  105.       i := 1;
  106.       WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i])) AND
  107.              (i<12) DO
  108.        INC(i);
  109.  
  110.       IF ((searchdesc = '') AND
  111.           ((ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
  112.            (FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i])) THEN
  113.        ShowCompLZHFileData(search,lhsearch,Dir,csize);
  114.      END;
  115.  
  116.     INC(BufPtr,csize); INC(FilePtr,csize);
  117.     IF BufPtr >= BufSize THEN
  118.      BEGIN
  119.       Seek(f,FilePtr);
  120.       BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
  121.      END;
  122.    END;
  123.  UNTIL BufPtr >= BytesRead;
  124.  
  125.  Close(f);
  126. END; (* SearchInLZHFile *)
  127.  
  128. PROCEDURE ShowCompLZHFileData(VAR search,lhsearch: SearchRec;VAR Path: PathStr;
  129.                               csize: LONGINT);
  130.  
  131. BEGIN
  132.  IF NOT BareOutput THEN
  133.   BEGIN
  134.    IF FileCount = 0 THEN
  135.     BEGIN
  136.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  137.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  138.     END;
  139.  
  140.    IF lhsearch.Name <> OldLHFileName THEN
  141.     BEGIN
  142.      DownString(lhsearch.Name); OldLHFileName := lhsearch.Name;
  143.  
  144.      InfoArray[0] := @lhsearch.Name;
  145.  
  146.      SizeStr := FormattedLongIntStr(lhsearch.Size,8);
  147.      InfoArray[1] := @SizeStr;
  148.  
  149.      UnpackTime(lhsearch.Time,DateRec);
  150.      Date := FormDate(DateRec); Time := FormTime(DateRec);
  151.      InfoArray[2] := @Date;
  152.      InfoArray[3] := @Time;
  153.  
  154.      AttrStr := '....';
  155.      IF lhSearch.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  156.      IF lhSearch.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  157.      IF lhSearch.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  158.      IF lhSearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'r';
  159.      InfoArray[4] := @AttrStr;
  160.  
  161.      FormatStr(s,'(%-12s   %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
  162.      WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  163.     END;
  164.  
  165.    InfoArray[0] := @search.Name;
  166.  
  167.    SizeStr := FormattedLongIntStr(search.Size,8);
  168.    InfoArray[1] := @SizeStr;
  169.  
  170.    UnpackTime(search.Time,DateRec);
  171.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  172.    InfoArray[2] := @Date;
  173.    InfoArray[3] := @Time;
  174.  
  175. (*   AttrStr := '----';
  176.    IF Search.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  177.    IF Search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  178.    IF Search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  179.    IF Search.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'o'
  180.                                           ELSE AttrStr[4] := 'w';
  181.    InfoArray[4] := LONGINT(@AttrStr);
  182.  
  183.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl+' %4s',InfoArray); *)
  184.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl,InfoArray);
  185.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  186.  
  187.    INC(TotalSize,csize); INC(DirSize,csize);
  188.    INC(TotalFileCount);  INC(FileCount);
  189.   END;
  190. END; (* ShowFileData *)
  191.  
  192. END.